home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0391B.ZIP / PTOOLWIN.ARC / PTOOLWIN.INC < prev    next >
Text File  |  1985-09-24  |  11KB  |  262 lines
  1.  { PTOOLWIN.INC   Copyright 1984  R D Ostrander                   Version 1.0
  2.                                  Ostrander Data Services
  3.                                  5437 Honey Manor Dr
  4.                                  Indianapolis  IN  46241
  5.  
  6.  These Turbo Pascal procedures are text window manipulation tools used to ease
  7.  the manipulation of Windows in an IBM PC environment. They are used to open
  8.  and close windows while saving the data covered by the window. Borders around
  9.  windows are also supported.
  10.  
  11.  This program has been placed in the Public Domain by the author and copies
  12.  may be freely made for non-commercial, demonstration, or evaluation purposes.
  13.  Use of these subroutines in a program for sale or for commercial purposes in
  14.  a place of business requires a $20 fee be paid to the author at the address
  15.  above.  Personal non-commercial users may also elect to pay the $20 fee to
  16.  encourage further development of this and similar programs. With payment you
  17.  will be able to receive update notices, diskettes and printed documentation
  18.  of this and other PTOOLs from Ostrander Data Services.
  19.  
  20.  
  21.  PTOOL, and PTOOLxxx are Copyright Trademarks of Ostrander Data Services
  22.  
  23.  Turbo Pascal is a Copyright of Borland International Inc.
  24.  
  25. Procedures and Functions available in PTOOLWIN.INC are:
  26.  
  27.  
  28.  PTWSet  (Screen#, X1, Y1, X2, Y2,  - Sets up window coordinates so that later
  29.          BorderSwitch,                references can be made by Mnemonic only.
  30.          BackgroundColor,             PTWSet must be done once for each window
  31.          ForegroundColor)             before it is Opened.
  32.                                       The Screen# is a number between 1 and
  33.                                       the maximum number of windows allowable
  34.                                       set in the Constants Block below.
  35.                                       The X and Y Coordinates are the same as
  36.                                       for the Turbo Pascal Window procedure.
  37.                                       A border may be placed around the window
  38.                                       and the size of the window will be
  39.                                       decreased to fit inside the border. The
  40.                                       BorderSwitch functions are:
  41.                                          0 - No border
  42.                                          1 - Single line block graphics border
  43.                                          2 - Double line block graphics border
  44.                                         -1 - Single line Reversed color border
  45.                                         -2 - Double line Reversed color border
  46.                                       The BackgroundColor and ForegroundColor
  47.                                       parameters are the same as for the Turbo
  48.                                       Pascal TextColor and TextBackground
  49.                                       procedures.
  50.  
  51.  PTWOpen (Screen#)                  - Activates a window (previously set by
  52.                                       PTWSet) and saves the screen covered by
  53.                                       the window.
  54.                                       In the Constants Block following, there
  55.                                       is a parameter that sets the maximum
  56.                                       number of windows that may be open at
  57.                                       any one time.
  58.  
  59.  PTWClose                           - De-activates the open window, activates
  60.                                       the previous window and restores the
  61.                                       screen covered by the closed window.
  62.                                       Note that the PTWOpen & PTWClose have a
  63.                                       "Push/Pop" type of action.
  64.                                                                             }
  65.  
  66.  
  67. { Constant Values (Parameters) That must be included in your source program }
  68.  
  69. (*
  70. CONST
  71.  
  72.    PTOOLWIN_Number_of_Windows = 10;    { This determines the number of      }
  73.                                        { windows that may be set with the   }
  74.                                        { PTWSet procedure.                  }
  75.  
  76.    PTOOLWIN_Max_Number_Open = 10;      { This determines the number of      }
  77.                                        { windows that may be open at any    }
  78.                                        { one time. 4K bytes are reserved    }
  79.                                        { each window.                       }
  80.  
  81.    PTOOLWIN_Screen_Type : Char = 'C';  { This must be a 'C' if the program  }
  82.                                        { is to be run on a system with a    }
  83.                                        { Color/Graphics card and must be a  }
  84.                                        { 'M' if the program is to be run on }
  85.                                        { a system with a Monochrome card or }
  86.                                        { on an IBM-3270-PC.                 }
  87.                                                                            *)
  88.  
  89. { Areas for internal use Begin Here **************************************** }
  90.  
  91. TYPE
  92.  
  93.      PTOOLWIN_Set_Info  = Record
  94.                             PTOOLWIN_X1       : Integer;
  95.                             PTOOLWIN_Y1       : Integer;
  96.                             PTOOLWIN_X2       : Integer;
  97.                             PTOOLWIN_Y2       : Integer;
  98.                             PTOOLWIN_Border   : Integer;
  99.                             PTOOLWIN_Back     : Integer;
  100.                             PTOOLWIN_Fore     : Integer;
  101.                           End;
  102.  
  103.      PTOOLWIN_Stacks    = Array [1..25] of String [160];
  104.  
  105.  
  106. VAR
  107.  
  108.      PTOOLWIN_C_Screen   : Char absolute $B800:$0000;
  109.      PTOOLWIN_M_Screen   : Char absolute $B000:$0000;
  110.  
  111.      PTOOLWIN_Set        : Array [1..PTOOLWIN_Number_of_Windows]
  112.                                   of PTOOLWIN_Set_Info;
  113.  
  114.      PTOOLWIN_Stack_Num  : Array [1..PTOOLWIN_Max_Number_Open] of Integer;
  115.      PTOOLWIN_Stack_X    : Array [1..PTOOLWIN_Max_Number_Open] of Integer;
  116.      PTOOLWIN_Stack_Y    : Array [1..PTOOLWIN_Max_Number_Open] of Integer;
  117.      PTOOLWIN_Stack      : Array [1..PTOOLWIN_Max_Number_Open]
  118.                                   of PTOOLWIN_Stacks;
  119.  
  120.      PTOOLWIN_Curr       : PTOOLWIN_Set_Info;
  121.  
  122.  
  123. CONST
  124.  
  125.      PTOOLWIN_Stack_Size : Byte = 0;
  126.  
  127.      PTOOLWIN_Full_Screen : PTOOLWIN_Set_Info = (PTOOLWIN_X1     : 1;
  128.                                                  PTOOLWIN_Y1     : 1;
  129.                                                  PTOOLWIN_X2     : 80;
  130.                                                  PTOOLWIN_Y2     : 25;
  131.                                                  PTOOLWIN_Border : 0;
  132.                                                  PTOOLWIN_Back   : 0;
  133.                                                  PTOOLWIN_Fore   : 15);
  134.  
  135. { Internal Procedures Begin Here ****************************************** }
  136.  
  137.  
  138. Procedure PTOOLWIN_Open_Window (Screen : Integer; OpenType : Char);
  139.  
  140. Var
  141.    I  : Byte;
  142.  
  143. Begin
  144.      If (Screen = 0) or
  145.         (PTOOLWIN_Stack_Size = 0) then PTOOLWIN_Curr := PTOOLWIN_Full_Screen
  146.                                   else PTOOLWIN_Curr := PTOOLWIN_Set [Screen];
  147.      With PTOOLWIN_Curr do
  148.      Begin
  149.           Window (PTOOLWIN_X1, PTOOLWIN_Y1,
  150.                   PTOOLWIN_X2, PTOOLWIN_Y2);
  151.           If PTOOLWIN_Border >= 0 then
  152.             Begin
  153.                   TextBackground (PTOOLWIN_Back);
  154.                   TextColor      (PTOOLWIN_Fore);
  155.              End
  156.           else
  157.              Begin
  158.                   TextBackground (PTOOLWIN_Fore);
  159.                   TextColor      (PTOOLWIN_Back);
  160.              End;
  161.          If (Abs (PTOOLWIN_Border) = 1) and
  162.             (OpenType = 'N') then
  163.             Begin
  164.                  Gotoxy (1,1); Write ('┌');
  165.                  For I := 2 to PTOOLWIN_X2 - PTOOLWIN_X1 do
  166.                      Write ('─');
  167.                  Write ('┐');
  168.                  For I := 2 to PTOOLWIN_Y2 - PTOOLWIN_Y1 do
  169.                      Begin
  170.                           Gotoxy (1, I);
  171.                           Write ('│');
  172.                           Gotoxy (PTOOLWIN_X2 - PTOOLWIN_X1 + 1, I);
  173.                           Write ('│');
  174.                      End;
  175.                  Gotoxy (1, PTOOLWIN_Y2 - PTOOLWIN_Y1 + 1); Write ('└');
  176.                  For I := 2 to PTOOLWIN_X2 - PTOOLWIN_X1 do
  177.                      Write ('─');
  178.             End;
  179.          If (Abs (PTOOLWIN_Border) = 2) and
  180.             (OpenType = 'N') then
  181.             Begin
  182.                  Gotoxy (1,1); Write ('╔');
  183.                  For I := 2 to PTOOLWIN_X2 - PTOOLWIN_X1 do
  184.                      Write ('═');
  185.                  Write ('╗');
  186.                  For I := 2 to PTOOLWIN_Y2 - PTOOLWIN_Y1 do
  187.                      Begin
  188.                           Gotoxy (1, I);
  189.                           Write ('║');
  190.                           Gotoxy (PTOOLWIN_X2 - PTOOLWIN_X1 + 1, I);
  191.                           Write ('║');
  192.                      End;
  193.                  Gotoxy (1, PTOOLWIN_Y2 - PTOOLWIN_Y1 + 1); Write ('╚');
  194.                  For I := 2 to PTOOLWIN_X2 - PTOOLWIN_X1 do
  195.                      Write ('═');
  196.             End;
  197.          If PTOOLWIN_Border <> 0 then
  198.             Begin
  199.                  Window (PTOOLWIN_X1 + 1, PTOOLWIN_Y1 + 1,
  200.                          PTOOLWIN_X2 - 1, PTOOLWIN_Y2 - 1);
  201.                  If OpenType = 'N' then
  202.                     If Abs (PTOOLWIN_Border) = 1 then Write ('┘')
  203.                                                  else Write ('╝');
  204.             End;
  205.          TextBackground (PTOOLWIN_Back);
  206.          TextColor      (PTOOLWIN_Fore);
  207.      End;
  208. End;
  209.  
  210.  
  211. { Called Procedures Begin Here ******************************************** }
  212.  
  213.  
  214. PROCEDURE PTWSet (Window, X1, Y1, X2, Y2, Border, Back, Fore  : Integer);
  215.  
  216. BEGIN
  217.  
  218.      With PTOOLWIN_Curr do
  219.      Begin
  220.           PTOOLWIN_X1     := X1;
  221.           PTOOLWIN_Y1     := Y1;
  222.           PTOOLWIN_X2     := X2;
  223.           PTOOLWIN_Y2     := Y2;
  224.           PTOOLWIN_Border := Border;
  225.           PTOOLWIN_Back   := Back;
  226.           PTOOLWIN_Fore   := Fore;
  227.      End;
  228.      PTOOLWIN_Set [Window] := PTOOLWIN_Curr;
  229.  
  230. END;
  231.  
  232.  
  233. PROCEDURE PTWOpen (Screen : Integer);
  234.  
  235. BEGIN
  236.  
  237.      PTOOLWIN_Stack_Size := PTOOLWIN_Stack_Size + 1;
  238.      PTOOLWIN_Stack_Num [PTOOLWIN_Stack_Size] := Screen;
  239.      PTOOLWIN_Stack_X   [PTOOLWIN_Stack_Size] := WhereX;
  240.      PTOOLWIN_Stack_Y   [PTOOLWIN_Stack_Size] := WhereY;
  241.      If PTOOLWIN_Screen_Type = 'C' then
  242.         Move (PTOOLWIN_C_Screen, PTOOLWIN_Stack [PTOOLWIN_Stack_Size], 4000)
  243.      else
  244.         Move (PTOOLWIN_M_Screen, PTOOLWIN_Stack [PTOOLWIN_Stack_Size], 4000);
  245.      PTOOLWIN_Open_Window (Screen, 'N');
  246.  
  247. END;
  248.  
  249.  
  250. PROCEDURE PTWClose;
  251.  
  252. BEGIN
  253.      If PTOOLWIN_Screen_Type = 'C' then
  254.         Move (PTOOLWIN_Stack [PTOOLWIN_Stack_Size], PTOOLWIN_C_Screen, 4000)
  255.      else
  256.         Move (PTOOLWIN_Stack [PTOOLWIN_Stack_Size], PTOOLWIN_M_Screen, 4000);
  257.      PTOOLWIN_Stack_Size := PTOOLWIN_Stack_Size - 1;
  258.      PTOOLWIN_Open_Window (PTOOLWIN_Stack_Num [PTOOLWIN_Stack_Size], 'R');
  259.      Gotoxy (PTOOLWIN_Stack_X [PTOOLWIN_Stack_Size + 1],
  260.              PTOOLWIN_Stack_Y [PTOOLWIN_Stack_Size + 1]);
  261.  
  262. END;